perm filename WHAM.BAM[1,JRA] blob
sn#016818 filedate 1972-12-12 generic text, type T, neo UTF8
00100
00110 (DE RESOLV(C D)
00120 (COND((AND(ALLPOS C)(ALLPOS D))NIL)
00130 ((AND(ALLNEG C)(ALLNEG D))NIL)
00135 ((NOT(HERE C)) NIL)((NOT(HERE D))NIL)
00140 (T(RESOLVE C D))) )
00150
00200
00300 (DEFPROP RESOLVEL
00400 (LAMBDA(C D)
00500 (PROG (Z)
00550 (SETQ Z1 C)
00600 A
00650 (SETQ Z (RESOLV C (CAR D)))
00700 (COND (Z (RETURN Z)))
00800 B (SETQ D (CDR D))
00900 (COND (D (SETQ Z2(CAR D))(GO A)))
01000 (RETURN NIL)))
01100 EXPR)
01200
01300 (DEFPROP UNITUNITRES
01400 (LAMBDA(L R)
01500 (PROG (L1 Z)
01550 (COND((NULL L)(RETURN NIL)))(SETQ L1 L)
01600 A
01650 (COND ((RESOLV (CAR L1) (CAR R)) (RETURN (CONS (CAR L1) (CAR R)))))
01700 B (SETQ L1 (CDR L1))
01800 (COND (L1 (GO A)))
01900 (SETQ R (CDR R))
02000 (COND (R (SETQ L1 L) (GO A)))
02100 (RETURN NIL)))
02200 EXPR)
02300
02400 (DEFPROP SPLITEM
02500 (LAMBDA(L)
02600 (PROG (U NU)
02700 A (COND ((EQ (LENGTH (CDAR L)) 1) (SETQ U (CONS (CAR L) U))) (T (SETQ NU (CONS (CAR L) NU))))
02800 (SETQ L (CDR L))
02900 (COND (L (GO A)) (T (RETURN (CONS U NU))))))
03000 EXPR)
03100
03200 (DEFPROP UNITRES1
03300 (LAMBDA(C US)
03400 (PROG (R)
03500 (SETQ Z1 C)
03600 A (SETQ Z2 (CAR US))
03700 (SETQ R (APPEND R (RESOLV Z1 Z2)))
03800 B (SETQ US (CDR US))
03900 (COND (US (GO A)))
04000 (RETURN R)))
04100 EXPR)
04200
04300 (DEFPROP TRYPRF
04400 (LAMBDA(L)
04500 (PROG (U A C FLG R Z1 Z2 Z CNT )(SETQ CNT 0)
04600 (SETQ Z (SPLITEM L))
04700 (SETQ U (CAR Z))
04800 (SETQ A (CDR Z))
04900 (SETQ C NIL)
05000 (SETQ FLG NIL)
05100 A (COND ((NULL (SETQ R (UNITRES1 (CAR A) U))) (SETQ C (APPEND C (LIST (CAR A)))) (SETQ A (CDR A)) (GO B))
05200 ((MEMQ NIL R) (PROOF Z1 Z2) (RETURN (QUOTE QED))))
05300 (SETQ R (FINI L R Z1 Z2 EE1))
05350 (SETQ CNT(PLUS CNT(LENGTH R)))
05400 (COND ((NULL R) (SETQ C (APPEND C (LIST (CAR A)))) (SETQ A (CDR A)) (GO B)))
05500 (SETQ Z (SPLITEM R))
05600 (COND ((SETQ R (UNITUNITRES (CAR Z) U)) (PROOF (CAR R) (CDR R)) (RETURN (QUOTE QED))))
05700 (SETQ U (APPEND U (CAR Z)))
05800 (SETQ A (APPEND (CDR Z) (CDR A)(LIST(CAR A))))
05900 B(COND((TTYIN)(UPDATE CLAUSES)))
05950 (COND (A (GO A)) ((NULL FLG) (SETQ A C) (SETQ C NIL) (SETQ FLG T) (GO A)))
06000 (SETQ FLG NIL)
06100 (SETQ C1 (REVERSE C))
06200 C (SETQ Z (RESOLVEL (CAR C1) C))
06300 (COND ((NULL Z) (GO C1)))
06400 (SETQ Z (FINI L Z Z1 Z2 EE1))
06450 (SETQ CNT(PLUS CNT(LENGTH Z)))
06500 (COND ((NULL Z) (GO C1)))
06600 (SETQ A (APPEND Z (CDR C) (LIST (CAR C))))
06700 (SETQ C NIL)
06800 (GO A)
06900 C1 (SETQ C1 (CDR C1))
07000 (COND (C1 (GO C)))
07100 (PRINT (QUOTE LOSE))))
07200 EXPR)
07300
07400 (DEFPROP FINI
07500 (LAMBDA(U R Z1 Z2 E)
07600 (PROG (Z)
07700 (COND (UFLG (SETQ R (UNITREDUCT R UNAXP UNAXN))))
07800 (COND ((NULL R) (RETURN NIL)) ((NULL (CAR R)) (PROOF Z1 Z2) (ERR (QUOTE (QED)))))
07900 (SETQ COUNT (PLUS COUNT (LENGTH R)))
08000 (SETQ R (EDIT U R))
08100 (CLAUSES2 R)
08200 (COND ((NULL R) (RETURN NIL)))
08300 (BAKSUB CLAUSES R)
08400 (BOOKEEP E R (CONS Z1 Z2))
08500 (SETQ Z (UNITPN R))
08600 (SETQ UNAXP (APPEND (CAR Z) UNAXP))
08700 (SETQ UNAXN (APPEND (CDR Z) UNAXN))
08800 (RETURN R)))
08900 EXPR)
09000
09100 (DEFPROP AUTO
09200 (LAMBDA(XX)
09300 (PROG (X1 Z2 D M STRATEGY SUPPORT EDITSTRAT MERGE ORDER DEBUG ANCESTRY PMODEL NMODEL PFLG PDEPTH DLIST)
09400 (COND (EQUAL (SETQ PFLG NIL)) (T (SETQ PFLG NIL)))
09500 (SETQ PDEPTH 101)
09600 (SETQ DDEPTH 1)
09700 (COND
09800 ((NULL EQUAL) (PRINT (QUOTE (IS THERE AN EQUALITY PREDICATE (Y / N))))
09900 (COND
10000 ((EQ (READ) (QUOTE Y)) (PRINT (QUOTE (WHAT IS IT)))
10100 (SETQ PFLG NIL)
10200 (SETQ EQUAL (READ))))))
10300 (SETQ X1 XX)
10400 (SETQ M (SETQ D 0))
10500 A (SETQ M (MAX M (LENGTH (CDAR X1))))
10600 (SETQ D (MAX D (DEPTH (CDAR X1))))
10700 (SETQ Z2 (CAR X1))
10800 (COND
10900 ((AND (EQ (LENGTH (CDR Z2)) 1) (EQ (CAADR Z2) EQUAL) (NOT (EQ (CADADR Z2) (CAR (CDDADR Z2)))))
11000 (SETQ DLIST (CONS (CONS (CONS (CAAAR Z2) (CDAR Z2)) (CDR Z2)) DLIST))))
11100 (SETQ X1 (CDR X1))
11200 (COND ((CDR X1) (GO A)))
11300 (SETQ Z2 (ASSOC (QUOTE THEOREM) NEWNAME))
11400 (COND ((NULL Z2) (GO C)) (T (SETQ Z2 (CDR Z2))))
11500 B (COND (Z2 (SETQ SUPPORT (CONS (CDAR Z2) SUPPORT)) (SETQ Z2 (CDR Z2)) (GO B)))
11600 C (COND ((NULL LENGTH) (SETQ LENGTH (DIFFERENCE (PLUS M (LENGTH (CDAR X1))) 2)))
11700 ((ZEROP ITER) (SETQ LENGTH (ADD1 LENGTH))))
11800 (COND ((NOT (GREATERP LENGTH 0)) (SETQ LENGTH 1)))
11900 (COND ((NULL DEPTH) (SETQ DEPTH (ADD1 D))) ((NOT (ZEROP ITER)) (SETQ DEPTH (ADD1 DEPTH))))
12000 (COND ((ZEROP ITER) (SETQ ITER 1)) (T (SETQ ITER 0)))
12100 (SETQ STRATEGY NIL)(SETQ DEPTH 4)
12200 (SETQ EDITSTRAT
12300 (QUOTE (LAMBDA (C) (OR (GREATERP (LENGTH (CDR C)) LENGTH) (GREATERP (DEPTH (CDR C)) DEPTH)))))
12400 (SETQ DEBUG T)
12500 (SETQ DLIST NIL)
12600 (RETURN
12700 (LIST STRATEGY
12800 SUPPORT
12900 EDITSTRAT
13000 MERGE
13100 ORDER
13200 DEBUG
13300 DEPTH
13400 LENGTH
13500 ANCESTRY
13600 PMODEL
13700 NMODEL
13800 PFLG
13900 EQUAL
14000 PDEPTH
14100 DLIST))))
14200 EXPR)